-- ??? {-# LANGUAGE CPP, ForeignFunctionInterface #-}
module Retro8 ( SurfaceTiles
              , SurfaceTilesStruct
              , TiledScreen
              , TiledScreenStruct
              , blitScreen
              , blitScreenXY
              , createTiledScreenUsingSurface
              , fillScreen
              , pokeScreen
              , scrollScreenUp
              ) where

import Foreign
import Foreign.C
import Graphics.UI.SDL
  
-- ##################################################################
-- Data Types
-- ##################################################################

data SurfaceTilesStruct
type SurfaceTiles = ForeignPtr SurfaceTilesStruct

data TiledScreenStruct
type TiledScreen = ForeignPtr TiledScreenStruct


-- ##################################################################
-- foreign imports
-- ##################################################################

-- R8B_Surface_Tiles *r8b_createSurfaceTiles(SDL_Surface *src, int w, int h);
foreign import ccall unsafe "tiles.h r8b_createSurfaceTiles" r8b_createSurfaceTiles :: Ptr SurfaceStruct -> CInt -> CInt -> IO (Ptr SurfaceTilesStruct)
-- void r8b_freeSurfaceTiles(R8B_Surface_Tiles *s);
foreign import ccall unsafe "tiles.h r8b_freeSurfaceTiles" r8b_freeSurfaceTiles :: Ptr SurfaceTilesStruct -> IO ()
foreign import ccall unsafe "tiles.h &r8b_freeSurfaceTiles" r8b_freeSurfaceTilesFIN :: FunPtr (Ptr SurfaceTilesStruct -> IO ())

-- R8B_Tiled_Screen *r8b_createTiledScreen_using_surface(int width, int height, int default_fill, SDL_Surface *surf, int tile_width, int tile_height);
foreign import ccall unsafe "tiles.h r8b_createTiledScreen_using_surface" r8b_createTiledScreen_using_surface :: CInt -> CInt -> CInt -> Ptr SurfaceStruct -> CInt -> CInt -> IO (Ptr TiledScreenStruct)
foreign import ccall unsafe "&r8b_freeTiledScreen" r8b_freeTiledScreenFIN :: FunPtr (Ptr TiledScreenStruct -> IO ())
-- int r8b_blitScreen(R8B_Tiled_Screen *src, SDL_Surface *dst, SDL_Rect *dstrect);
foreign import ccall unsafe "tiles.h r8b_blitScreen" r8bBlitScreen :: Ptr TiledScreenStruct -> Ptr SurfaceStruct -> Ptr Rect -> IO CInt
--int r8b_blitScreenXY(R8B_Tiled_Screen *src, SDL_Surface *dst, int x, int y);
foreign import ccall unsafe "tiles.h r8b_blitScreenXY" r8bBlitScreenXY :: Ptr TiledScreenStruct -> Ptr SurfaceStruct -> CInt -> CInt -> IO CInt
-- void r8b_fillScreen(R8B_Tiled_Screen *dst, int c)
foreign import ccall unsafe "tiles.h r8b_fillScreen" r8b_fillScreen :: Ptr TiledScreenStruct -> CInt -> IO ()
-- void r8b_pokeScreen(R8B_Tiled_Screen *dst, int x, int y, int c);
foreign import ccall unsafe "tiles.h r8b_pokeScreen" r8bPokeScreen :: Ptr TiledScreenStruct -> CInt -> CInt -> CInt -> IO ()
-- void r8b_scrollScreenUp(R8B_Tiled_Screen *dst);
foreign import ccall unsafe "tiles.h r8b_scrollScreenUp" r8b_scrollScreenUp :: Ptr TiledScreenStruct -> IO ()

-- ##################################################################
-- helper functions
-- ##################################################################

toCInt :: Int -> CInt
toCInt = fromIntegral


-- ##################################################################
-- Haskell functions
-- ##################################################################

createSurfaceTiles :: Surface -> Int -> Int -> IO (Maybe SurfaceTiles)
createSurfaceTiles srf wi he = withForeignPtr srf $ \srfPtr -> r8b_createSurfaceTiles srfPtr (toCInt wi) (toCInt he) >>= maybePeek mkFinalisedSurfaceTiles
mkFinalisedSurfaceTiles :: Ptr SurfaceTilesStruct -> IO SurfaceTiles
mkFinalisedSurfaceTiles = newForeignPtr r8b_freeSurfaceTilesFIN
freeSurfaceTiles :: SurfaceTiles -> IO ()
freeSurfaceTiles srf = withForeignPtr srf r8b_freeSurfaceTiles

createTiledScreenUsingSurface :: Int -> Int -> Int -> Surface -> Int -> Int -> IO (Maybe TiledScreen)
createTiledScreenUsingSurface w h f srf tileW tileH = withForeignPtr srf $ \srfPtr -> r8b_createTiledScreen_using_surface (toCInt w) (toCInt h) (toCInt f) srfPtr (toCInt tileW) (toCInt tileH) >>= maybePeek mkFinalisedTiledScreen
mkFinalisedTiledScreen :: Ptr TiledScreenStruct -> IO TiledScreen
mkFinalisedTiledScreen = newForeignPtr r8b_freeTiledScreenFIN
blitScreen :: TiledScreen -> Surface -> Maybe Rect -> IO Bool
blitScreen scr surf r = withForeignPtr scr $ \screenPtr ->
                        withForeignPtr surf $ \surfPtr -> 
                        maybeWith Foreign.with r $ \rectPtr ->
                        ((-1) /=) `fmap` r8bBlitScreen screenPtr surfPtr rectPtr
blitScreenXY :: TiledScreen -> Surface -> Int -> Int -> IO Bool
blitScreenXY scr surf x y = withForeignPtr scr (\screenPtr ->
                                                 withForeignPtr surf $ \surfPtr -> 
                                                 ((-1) /=) `fmap` r8bBlitScreenXY screenPtr surfPtr (toCInt x) (toCInt y))
fillScreen :: TiledScreen -> Int -> IO ()
fillScreen scr c = withForeignPtr scr $ \sP -> r8b_fillScreen sP (toCInt c)
pokeScreen :: TiledScreen -> Int -> Int -> Int -> IO ()
pokeScreen scr x y c = withForeignPtr scr $ \screenPtr -> 
  r8bPokeScreen screenPtr (toCInt x) (toCInt y) (toCInt c)
scrollScreenUp :: TiledScreen -> IO ()
scrollScreenUp scr = withForeignPtr scr r8b_scrollScreenUp
